home *** CD-ROM | disk | FTP | other *** search
/ Die Ultimative Software-P…i Collection 1996 & 1997 / Die Ultimative Software-Pakete CD-ROM fur Atari Collection 1996 & 1997.iso / u / utility / 1st_word / wprint / wprint.mod < prev    next >
Encoding:
Text File  |  1996-11-17  |  37.2 KB  |  1,081 lines
  1. MODULE WPrint;
  2.  
  3. FROM SYSTEM IMPORT VAL, ADDRESS, ADR, LONG;
  4. (* Libary SYSTEM *)
  5. FROM Application IMPORT Init, Terminate;
  6. IMPORT GEMDOS;
  7. FROM Clock IMPORT Time, GetTime;
  8. FROM FileName IMPORT filename, compose, GetDriveAndPath, ClearFilename;
  9. FROM TermWindow IMPORT WriteString, WriteLn, Read, Write, GetPos, SetPos, 
  10.                        Tab, ResetTerminal, InitTerminal, OpenTerminal, 
  11.                        CloseTerminal, DeleteTerminal, NewTitle;
  12. (* Libary GEMLIB *)
  13. FROM AES IMPORT WindowGet, FormAlert, GrafMouse;
  14. FROM GEMAESBase IMPORT WorkXYWH;
  15. IMPORT Terminal; (* STDLIB *)
  16. (* MYLIB *)
  17. FROM DruckTreiber IMPORT ConfigPrinter, PrintChar, PrintLn, PrintFormFeed,
  18.                          PrintHandle, Steuer, SetLQ, CfgError, S;
  19. FROM Storage IMPORT Available, Allocate, Deallocate;
  20. FROM Strings IMPORT Delete, Insert, Concat, Length, IntToString, StringToInt, 
  21.                     Assign, Copy, Fill, LongIntToString;
  22. FROM XFSelect IMPORT ExSelectFilename;
  23.  
  24. CONST StdTimeout = 10000D;
  25.  
  26. TYPE Schriftarten = (nix, Pica, Elite, Schmal, Breit);
  27.      Schriftart = RECORD
  28.                     p: Schriftarten;
  29.                     prop: BOOLEAN;
  30.                   END;  
  31.      Ausgabegeraet = (datei,parallel,seriell);
  32.      String40 = ARRAY[0..39] OF CHAR;
  33.      KopfFussZeile = RECORD
  34.                        Links, Mitte, Rechts : String40;
  35.                        underlined, exists, onFirstPage : BOOLEAN;
  36.                      END;
  37.      DTAType = RECORD
  38.                  Attribut : ARRAY[0..21] OF CHAR;
  39.                  Date, Time : CARDINAL;
  40.                  Laenge : LONGCARD;
  41.                  Name : ARRAY[0..11]OF CHAR;
  42.                END;
  43.     ReadyProc = PROCEDURE() : BOOLEAN;
  44.                
  45. VAR Ready : ReadyProc;
  46.     Attribut : ARRAY[0..7]OF BOOLEAN;
  47.     DateString, TimeString, TxtHeadName : ARRAY[0..17] OF CHAR;
  48.     MainPitch, FNPitch, TextPitch, Pitch : Schriftart;
  49.     LineHight : ARRAY[Pica..Breit] OF INTEGER;
  50.     TextP, FNP,
  51.     PrinterTimeout : LONGCARD;
  52.     PStart, PufferT, Puffer, PufferBottom, PufferTop, PufferLaenge : LONGINT;
  53.     P : POINTER TO CHAR;
  54.     msg : String40;
  55.     KopfZeile, FussZeile : KopfFussZeile;
  56.     TxtMaske, CfgMaske, TxtDateiName, CfgDateiName, OutName, OutMaske
  57.     : filename;
  58.     BoxText, LeerString, OutDatei, CfgDatei, TxtDatei : ARRAY[0..127]OF CHAR;
  59.     Title, TxtHeadPath : ARRAY[0..77] OF CHAR;
  60.     WpPageLength, PageLength, RandOben, RandText, RandFuss, RandUnten, 
  61.     FNRandOben, FNRandUnten, FNOffset, oldFNOffset, FNcp, FNStrich, LinkerRand, 
  62.     RechterRand, PageNum, PageNumOffset,  ErsteSeite, LetzteSeite, LineOffset, 
  63.     LineNum, LHTeiler, PrnHandle, MaxLF, Zeile, FN1, FN2, FNist, DispZeile, 
  64.     xmin, ymin, breite, hoehe, PrintedPages
  65.      : INTEGER;
  66.     undefiniert, fertig, LQ, print, ende, KopfAlternierend, noFile, ueberspringen, ZeileistLeer : BOOLEAN;
  67.     c, TextAttribut, FNattribut : CHAR;
  68.     ausgabe : Ausgabegeraet;
  69.  
  70. PROCEDURE DateiReady() : BOOLEAN; BEGIN RETURN TRUE END DateiReady;
  71.  
  72. PROCEDURE KeyPressed() : BOOLEAN;
  73.   BEGIN
  74.     RETURN GEMDOS.ConIS()
  75.   END KeyPressed;
  76.   
  77. PROCEDURE Message(s : ARRAY OF CHAR);
  78.   VAR lin, col : INTEGER;
  79.   BEGIN
  80.     SetPos(19,1); Fill(LeerString,60-Length(s),' '); WriteString(s);
  81.     GetPos(lin,col); WriteString(LeerString); SetPos(lin,col);
  82.   END Message;
  83.  
  84. PROCEDURE WriteInt(n : INTEGER);
  85.   VAR h : ARRAY[0..3] OF CHAR; i : INTEGER;
  86.   BEGIN
  87.     IntToString(h,n);
  88.     FOR i:=1 TO 3-VAL(INTEGER,Length(h)) DO Write(' ') END;
  89.     WriteString(h);
  90.   END WriteInt;
  91.  
  92. PROCEDURE IntToRoman(VAR s : ARRAY OF CHAR; n : INTEGER; gross : BOOLEAN);
  93.   VAR l, f, z, e : INTEGER; EinsC, FuenfC, ZehnC : CHAR; neg : BOOLEAN;
  94.       EinsArray, FuenfArray : ARRAY[0..3] OF CHAR;
  95.   BEGIN
  96.     EinsArray:='ixcm'; FuenfArray:='vld '; e:=0; l:=0;
  97.     neg:=n<0; IF neg THEN n:=-n END;
  98.     WHILE (n>0) & (e<4) DO
  99.       EinsC:=EinsArray[e]; FuenfC:=FuenfArray[e];
  100.       IF e<3 THEN ZehnC:=EinsArray[e] END;
  101.       IF gross THEN EinsC:=CAP(EinsC); FuenfC:=CAP(FuenfC);
  102.                     ZehnC:=CAP(ZehnC); END;
  103.       z:=n MOD 10; f:=n MOD 5; n:=n DIV 10; INC(e); 
  104.       IF f=4 THEN IF z>5 THEN s[l]:=ZehnC ELSE s[l]:=FuenfC END;
  105.                   f:=1; INC(l)
  106.              ELSE IF z>4 THEN s[l]:=FuenfC; INC(l) END
  107.              END;
  108.       WHILE f>0 DO s[l]:=EinsC; INC(l); DEC(f); END;
  109.     END;
  110.     IF neg THEN s[l]:='-'; INC(l) END;
  111.     s[l]:=0C; DEC(l);
  112.     FOR e:=0 TO l DO EinsC:=s[e]; s[e]:=s[l-e]; s[l-e]:=EinsC END;
  113.   END IntToRoman;
  114.  
  115. PROCEDURE ReadString(lin,col : INTEGER; VAR s : ARRAY OF CHAR);
  116.   VAR c,c2,sc : CHAR; exit : BOOLEAN; 
  117.       x, hs,i,l,ll, VTlin, VTcol : INTEGER;
  118.       h,CursorOff : ARRAY[0..1] OF CHAR;
  119.       escape : ARRAY[0..7] OF CHAR;
  120.   BEGIN
  121.     h:=' '; x:=0; l:=0; hs:=HIGH(s); CursorOff:=' f'; CursorOff[0]:=33C;
  122.     escape:=' Y   e'; escape[0]:=33C; escape[4]:=33C;
  123.     VTcol:=col+1+(xmin-1) DIV 8; VTlin:=lin+1+(ymin+15) DIV 16;
  124.     REPEAT
  125.       exit:=FALSE; s[hs]:=0C;
  126.       SetPos(lin,col); WriteString(s); FOR i:=0 TO l-1 DO Write(' '); END;
  127.       l:=VAL(INTEGER,Length(s)); 
  128.       SetPos(lin,col+x);
  129.       escape[2]:=CHR(32+VTlin); escape[3]:=CHR(32+VTcol+x);
  130.       GEMDOS.ConWS(escape);
  131.       GEMDOS.RawScanIn(c,sc); GEMDOS.ConWS(CursorOff);
  132.       CASE c OF
  133.       0C: CASE sc OF
  134.             16C: IF x>0 THEN DEC(x); Delete(s,x,1); END;
  135.           | 34C,162C: exit:=TRUE;
  136.           | 107C: (* CLR *) s:=''; x:=0;
  137.           | 113C: (* $4B *) IF x>0 THEN DEC(x) END;
  138.           | 115C: (* $4D *) INC(x);
  139.           | 122C: (* Ins *) h[0]:=' '; Insert(h,VAL(CARDINAL,x),s);
  140.           | 123C: (* DEL *) IF l>0 THEN Delete(s,x,1); END;
  141.           ELSE
  142.           END;
  143.       | 10C: IF x>0 THEN DEC(x); Delete(s,x,1); END;
  144.       | 15C: exit:=TRUE;
  145.       | 177C: IF l>0 THEN Delete(s,x,1); END;
  146.       | 40C..176C, 200C..377C: 
  147.              h[0]:=c; Insert(h,VAL(CARDINAL,x),s); INC(x);
  148.       ELSE
  149.       END;
  150.       ll:=VAL(CARDINAL,Length(s));
  151.       IF x>ll THEN x:=ll END; IF x<0 THEN x:=0 END;
  152.       l:=l-ll;
  153.     UNTIL exit;
  154.   END ReadString;
  155.  
  156. PROCEDURE Initialisieren;
  157.   VAR i:INTEGER;
  158.       t : Time; h : ARRAY[0..11]OF CHAR;
  159.   BEGIN
  160.     FOR i:=0 TO 7 DO Attribut[i]:=TRUE END;
  161.     KopfAlternierend:=FALSE; FNist:=0;
  162.     PageNumOffset:=0; FNOffset:=0; oldFNOffset:=0; LineOffset:=8;
  163.     LinkerRand:=0; RechterRand:=0; WpPageLength:=72;
  164.     MainPitch.p:=nix; TextPitch.p:=Pica; Pitch.p:=nix; FNPitch.p:=nix;
  165.     MainPitch.prop:=FALSE; TextPitch.prop:=FALSE; Pitch.prop:=FALSE; FNPitch.prop:=FALSE;
  166.     LQ:=FALSE;
  167.     ErsteSeite:=1; LetzteSeite:=999;
  168.     WITH KopfZeile DO
  169.       Links:=''; Mitte:=''; Rechts:=''; 
  170.       onFirstPage:=TRUE; underlined:=FALSE; exists:=FALSE;
  171.     END;
  172.     FussZeile:=KopfZeile;
  173.  
  174.     GetTime(t);
  175.     IntToString(DateString,t.day MOD 32); t.day:=t.day DIV 32;
  176.     CASE (t.day MOD 16) OF
  177.       1: h:='.Januar ';
  178.     | 2: h:='.Februar ';
  179.     | 3: h:='.März ';
  180.     | 4: h:='.April ';
  181.     | 5: h:='.Mai ';
  182.     | 6: h:='.Juni ';
  183.     | 7: h:='.Juli ';
  184.     | 8: h:='.August ';
  185.     | 9: h:='.September ';
  186.     |10: h:='.Oktober ';
  187.     |11: h:='.November ';
  188.     |12: h:='.Dezember ';
  189.     ELSE
  190.     END;
  191.     Concat(DateString,h,DateString);
  192.     IntToString(h,1900+t.day DIV 16); Concat(DateString,h,DateString);
  193.     IntToString(TimeString,t.minute DIV 60); t.minute:=t.minute MOD 60;
  194.     IntToString(h,t.minute); Concat(TimeString,'.',TimeString);
  195.     IF t.minute<10 THEN Concat(TimeString,'0',TimeString) END;
  196.     Concat(TimeString,h,TimeString);
  197.   END Initialisieren;
  198.   
  199. PROCEDURE DruckAbbrechen() : BOOLEAN;
  200.   VAR res : INTEGER;
  201.   BEGIN
  202.     GrafMouse(257,NIL);
  203.     res:=FormAlert(1,BoxText);
  204.     GrafMouse(256,NIL);
  205.     IF res=2 THEN PufferT:=PufferBottom; print:=FALSE;
  206.                   Message('Druck abgebrochen nach'); ende:=TRUE; 
  207.                   RETURN TRUE
  208.              ELSE RETURN FALSE END;
  209.   END DruckAbbrechen;
  210.   
  211. PROCEDURE WaitForReady() : BOOLEAN;
  212.   VAR t: Time; add,t0,t1 : LONGCARD;
  213.   BEGIN
  214.     GetTime(t); t0:=LONG(t.millisecond); add:=0D;
  215.     REPEAT 
  216.       GetTime(t); t1:=LONG(t.millisecond);
  217.       IF t1<t0 THEN add:=60000D END;
  218.       t1:=add+t1;
  219.     UNTIL ((t1-t0)>PrinterTimeout) OR Ready();
  220.     IF Ready() THEN
  221.       RETURN FALSE
  222.     ELSE
  223.       IF ausgabe=parallel THEN
  224.         BoxText:='[1][ Drucker streikt! ][ weiter | abbrechen ]';
  225.       ELSE
  226.         BoxText:='[1][ Schnittstelle blockiert! ][ weiter | abbrechen ]';
  227.       END;
  228.       PrinterTimeout:=500D;
  229.       RETURN DruckAbbrechen();
  230.     END (* IF Ready() *);
  231.   END WaitForReady;
  232.  
  233. PROCEDURE SendChar(c : CHAR);
  234.   VAR ok : BOOLEAN; 
  235.   BEGIN
  236.     REPEAT
  237.       IF Ready() THEN PrintChar(c); ok:=TRUE; PrinterTimeout:=StdTimeout;
  238.                  ELSE ok:=WaitForReady(); END;
  239.     UNTIL ok;
  240.   END SendChar;
  241.  
  242. PROCEDURE SteuerCode( code, wert : INTEGER);
  243.   VAR ok : BOOLEAN;
  244.   BEGIN
  245.     IF ~ende THEN REPEAT
  246.         IF Ready() THEN Steuer(code,wert); ok:=TRUE; PrinterTimeout:=StdTimeout;
  247.                    ELSE ok:=WaitForReady() END;
  248.     UNTIL ok END;
  249.   END SteuerCode;
  250.  
  251. PROCEDURE PrintString( s : ARRAY OF CHAR);
  252.   VAR i,l : CARDINAL;
  253.   BEGIN
  254.     l:=Length(s);
  255.     IF l>0 THEN FOR i:=0 TO l-1 DO SendChar(s[i]) END END;
  256.   END PrintString;
  257.   
  258. PROCEDURE SetPitch ( p : Schriftart );
  259.   VAR code:INTEGER;
  260.   BEGIN
  261.       Pitch:=p;
  262.       CASE Pitch.p OF
  263.         Pica:   code:=28H;
  264.       | Elite:  code:=2AH;
  265.       | Schmal: code:=2CH;
  266.       | Breit:  code:=2EH;
  267.       END;
  268.       IF print THEN 
  269.         SteuerCode(code,-1);
  270.         IF p.prop THEN SteuerCode(35H,-1)
  271.                   ELSE SteuerCode(36H,-1); END;
  272.       END; 
  273.   END SetPitch;
  274.  
  275. PROCEDURE SetAttribut(c:CHAR);
  276.   VAR a,i,code : INTEGER;
  277.   BEGIN
  278.     a:=ORD(c);
  279.     FOR i:=0 TO 5 DO
  280.       IF ODD(a)#Attribut[i] THEN
  281.         Attribut[i]:=ODD(a);
  282.         CASE i OF
  283.           0: code:=6;
  284.         | 1: code:=0EH;
  285.         | 2: code:=0AH;
  286.         | 3: code:=1AH;
  287.         | 4: code:=12H;
  288.         | 5: code:=16H;
  289.         END;
  290.         IF ~Attribut[i] THEN code:=code+1 END;
  291.         SteuerCode(code,-1);
  292.       END;
  293.       a:=a DIV 2;
  294.     END;
  295.   END SetAttribut;
  296.   
  297. PROCEDURE GetC(VAR c :CHAR );
  298.   VAR h : ARRAY[0..3] OF CHAR;
  299.   BEGIN
  300.     IF Puffer<PufferT THEN P:=VAL(ADDRESS,Puffer); c:=P^;
  301.                       ELSE c:=0C END;
  302.   END GetC;
  303.   
  304. PROCEDURE NextC( VAR c : CHAR );
  305.   VAR h : ARRAY[0..3] OF CHAR;
  306.   BEGIN
  307.     IF Puffer<PufferT THEN
  308.       Puffer:=Puffer+1D; P:=VAL(ADDRESS,Puffer); c:=P^;
  309.       IF KeyPressed() THEN
  310.         BoxText:='[1][ Benutzerunterbrechung. ][ weiter | abbrechen ]';
  311.         IF DruckAbbrechen() THEN c:=0C END;
  312.       END;
  313.     ELSE c:=0C END;
  314.   END NextC;
  315.   
  316. PROCEDURE SkipLine;
  317.   VAR c:CHAR;
  318.   BEGIN
  319.     GetC(c); WHILE (c#0C) & (c#12C) DO NextC(c) END;
  320.     NextC(c); (* Anfang der nächsten Zeile *)
  321.   END SkipLine;
  322.  
  323. PROCEDURE GetInt(VAR i : INTEGER);
  324.   VAR c : CHAR;
  325.   BEGIN
  326.     GetC(c); i:=0;
  327.     WHILE (c>='0') &(c<='9') DO 
  328.       i:=10*i+ORD(c)-30H; NextC(c); END;
  329.   END GetInt;
  330.   
  331. PROCEDURE LinealLesen( rand : BOOLEAN; VAR p : Schriftart );
  332.   VAR c:CHAR; lr,rr : INTEGER;
  333.   BEGIN
  334.     NextC(c); lr:=0; rr:=0;
  335.     IF rand THEN
  336.       WHILE (c#0C) & (c#'[') DO NextC(c); INC(lr); END; rr:=lr END;
  337.     WHILE (c#0C) & (c#']') DO NextC(c); INC(rr); END; (* c jetzt = ']' *)
  338.     IF rand THEN LinkerRand:=lr; RechterRand:=rr END;
  339.     NextC(c); 
  340.     CASE c OF
  341.     '0': p.p:=Pica;  |
  342.     '1': p.p:=Elite; |
  343.     '2': p.p:=Schmal;|
  344.     '3': p.p:=Breit;
  345.     ELSE
  346.     END;
  347.     NextC(c); 
  348.     NextC(c); 
  349.     NextC(c); p.prop:=(c='1');
  350.   END LinealLesen;
  351.   
  352. PROCEDURE KopfZeileLesen( VAR Z : KopfFussZeile);
  353.   VAR i,j:INTEGER; c:CHAR;
  354.   BEGIN
  355.     WITH Z DO
  356.       i:=0; j:=0;
  357.       NextC(c);
  358.       WHILE c>36C DO
  359.         IF (c=37C) OR (c='|') THEN INC(i); j:=0;
  360.         ELSE IF j<39 THEN
  361.           IF c='_' THEN underlined:=TRUE
  362.           ELSE
  363.             CASE i OF
  364.               0: Links[j]:=c; Links[j+1]:=0C;   exists:=TRUE;
  365.             | 1: Mitte[j]:=c; Mitte[j+1]:=0C;   exists:=TRUE;
  366.             | 2: Rechts[j]:=c; Rechts[j+1]:=0C; exists:=TRUE;
  367.             | 3: onFirstPage:= c='1';
  368.             ELSE  
  369.             END (* CASE i OF *);
  370.             INC(j);
  371.           END (* IF c='_' .. ELSE *);
  372.         END (* IF j<39 *) END (* IF c=37C *);
  373.         NextC(c);
  374.       END (* WHILE c>36C *);
  375.     END; (* WITH Z *)
  376.   END KopfZeileLesen;
  377.   
  378. PROCEDURE ParameterBerechnen;
  379.   VAR lh : INTEGER;
  380.   BEGIN
  381.     LHTeiler:=180;
  382.     lh:=ORD(S.par[2])*6;
  383.     LineHight[Pica]:=  (45 * lh) DIV LHTeiler;
  384.     LineHight[Elite]:= 2*LineHight[Pica] DIV 3;
  385.     LineHight[Schmal]:=LineHight[Pica] DIV 2;
  386.     LineHight[Breit]:= 2*LineHight[Elite];
  387.     LHTeiler:=lh; MaxLF:=255 * LHTeiler DIV 180;
  388.   END ParameterBerechnen;
  389.  
  390. PROCEDURE GetParameter(VAR ok:BOOLEAN);
  391.   VAR c,cc:CHAR;
  392.   BEGIN
  393.     Puffer:=PufferBottom; PufferT:=PufferTop;
  394.     GetC(c); ok:=c=37C;
  395.     WHILE c=37C DO
  396.       NextC(c);
  397.       CASE c OF
  398.       '0': NextC(cc); WpPageLength:=10*(ORD(cc)-30H);
  399.            NextC(cc); WpPageLength:=WpPageLength+ORD(cc)-30H;
  400.            NextC(cc); NextC(cc); RandOben:=ORD(cc)-30H;
  401.            NextC(cc); NextC(cc); RandText:=ORD(cc)-30H;
  402.            NextC(cc); NextC(cc); RandFuss:=ORD(cc)-30H;
  403.            NextC(cc); NextC(cc); RandUnten:=ORD(cc)-30H; |
  404.       '1': KopfZeileLesen(KopfZeile);       |
  405.       '2': KopfZeileLesen(FussZeile);       |
  406.       'R': LinealLesen(FALSE,FNPitch);      |
  407.       'F': NextC(cc); NextC(cc); FNRandOben:=ORD(cc)-30H;
  408.            NextC(cc); FNRandUnten:=ORD(cc)-30H;
  409.            NextC(cc); NextC(cc); NextC(cc); FNStrich:=ORD(cc)-30H;
  410.            NextC(cc); FNStrich:=10*FNStrich+ORD(cc)-30H;
  411.            GetInt(FNOffset); FNOffset:=FNOffset-1;  |
  412.       '9': IF MainPitch.p=nix THEN LinealLesen(TRUE,MainPitch);
  413.                                  TextPitch:=MainPitch;
  414.                             ELSE LinealLesen(FALSE,TextPitch);
  415.                             END;
  416.       ELSE
  417.       END (* CASE *);
  418.       SkipLine; GetC(c);
  419.     END;
  420.     PStart:=Puffer;
  421.     IF MainPitch.p=nix THEN MainPitch.p:=Pica; END;
  422.     IF TextPitch.p=nix THEN TextPitch:=MainPitch; END;
  423.     IF FNPitch.p=nix   THEN FNPitch:=  MainPitch; END;
  424.   END GetParameter;
  425.  
  426. PROCEDURE SucheEinsF(x : CHAR);
  427.   VAR c:CHAR;
  428.   BEGIN
  429.     GetC(c);
  430.     REPEAT
  431.       WHILE (c#0C) & (c#37C) DO NextC(c); END;
  432.       NextC(c);
  433.     UNTIL (c=0C) OR (c=x);
  434.   END SucheEinsF;
  435.  
  436. PROCEDURE PrintKopfZeile(VAR z : KopfFussZeile);
  437.   VAR l : ARRAY[0..131] OF CHAR;
  438.       PageNumString : ARRAY[0..11] OF CHAR;
  439.       h : String40; 
  440.       j,PN : CARDINAL; i : INTEGER;
  441.   PROCEDURE Copy( VAR from, into : ARRAY OF CHAR; VAR p : CARDINAL);
  442.     VAR i,m,il : CARDINAL;
  443.     BEGIN
  444.       m:=Length(into); il:=VAL(CARDINAL,HIGH(into));
  445.       FOR i:=0 TO Length(from)-1 DO
  446.         IF p<=il THEN into[p]:=from[i] END;
  447.         INC(p) END;
  448.     END Copy;
  449.   PROCEDURE HS(VAR s : ARRAY OF CHAR );
  450.     VAR i,j : CARDINAL;
  451.     BEGIN
  452.       h[0]:=0C; j:=0; 
  453.       IF Length(s)>0 THEN
  454.         FOR i:=0 TO Length(s)-1 DO
  455.           CASE s[i] OF
  456.             '#': IntToString(PageNumString,PN); 
  457.                  Copy(PageNumString,h,j);
  458.           | '~': IntToRoman(PageNumString,PN,TRUE);  
  459.                  Copy(PageNumString,h,j);
  460.           | '%',
  461.             '@': Copy(DateString,h,j);
  462.           | '$': Copy(TimeString,h,j);
  463.           | '^': Copy(TxtHeadName,h,j);
  464.           | '\': Copy(TxtHeadPath,h,j);
  465.           ELSE
  466.             h[j]:=s[i]; INC(j);
  467.           END;
  468.         END;
  469.         IF j<=HIGH(h) THEN h[j]:=0C END;
  470.       END;
  471.     END HS;
  472.   BEGIN
  473.     IF (PageNum>1) OR z.onFirstPage THEN
  474.       PN:=PageNum+PageNumOffset; 
  475.       Fill(l,RechterRand,' ');
  476.       IF RechterRand<HIGH(l) THEN l[RechterRand+1]:=0C END;
  477.       (* Links *)
  478.       IF (KopfAlternierend & ODD(PN)) OR ~KopfAlternierend
  479.           THEN HS(z.Links)
  480.           ELSE HS(z.Rechts) END;
  481.       j:=VAL(CARDINAL,LinkerRand);
  482.       IF Length(h)>0 THEN Copy(h,l,j) END;
  483.       (* Mitte *)
  484.       HS(z.Mitte);
  485.       IF Length(h)>0 THEN
  486.         i:=RechterRand-LinkerRand-VAL(INTEGER,Length(h));
  487.         IF i<0 THEN j:=0 ELSE j:=VAL(CARDINAL,i DIV 2) END;
  488.         Copy(h,l,j); END;
  489.       (* Rechts *)
  490.       IF (KopfAlternierend & ODD(PN)) OR ~KopfAlternierend
  491.           THEN HS(z.Rechts)
  492.           ELSE HS(z.Links) END;
  493.       IF Length(h)>0 THEN
  494.         i:=RechterRand+1-VAL(INTEGER,Length(h));
  495.         IF i<0 THEN j:=0 ELSE j:=VAL(CARDINAL,i) END;
  496.         Copy(h,l,j) END;
  497.       PrintString(l);
  498.       SteuerCode(23H,-1);
  499.     END;
  500.   END PrintKopfZeile;
  501.  
  502. PROCEDURE GotoLineNum(ln : INTEGER);
  503.   VAR m : INTEGER; h : ARRAY[0..3] OF CHAR;
  504.   BEGIN
  505.     WHILE LineNum<ln DO
  506.       m:=ln-LineNum; IF m>MaxLF THEN m:=MaxLF END;
  507.       SteuerCode(25H,m);
  508.       PrintLn;
  509.       LineNum:=LineNum+m;
  510.     END;
  511. SetPos(18,23); WriteInt(ln);
  512.   END GotoLineNum;
  513.   
  514. PROCEDURE ZeilenAnfang(pitch:Schriftart; attribut:CHAR);
  515.   VAR i : INTEGER;
  516.   BEGIN
  517.     GotoLineNum(Zeile);
  518.     SetAttribut(0C); SetPitch(MainPitch);
  519.     IF S.c[5]>0 THEN SteuerCode(5,LineOffset)
  520.       ELSE FOR i:=1 TO LineOffset DO SendChar(' ') END END;
  521.     SetPitch(pitch); SetAttribut(attribut);
  522.   END ZeilenAnfang;
  523.   
  524. PROCEDURE ScanLine(SkipEinsC : INTEGER; VAR attr : CHAR; p : Schriftart);
  525.   VAR c : CHAR; fn, d, Leerzeichen : INTEGER; hp : LONGINT;
  526.       h : ARRAY[0..3] OF CHAR; oldattr : CHAR;
  527.   PROCEDURE SetPrintPos;
  528.     VAR i : INTEGER;
  529.     BEGIN
  530.       IF ZeileistLeer THEN ZeilenAnfang(p,oldattr) END;
  531.       ZeileistLeer:=FALSE;
  532.       IF Leerzeichen>0 THEN 
  533.         FOR i:=1 TO Leerzeichen DO SendChar(' ') END;
  534.         Leerzeichen:=0 END;
  535.     END SetPrintPos;
  536.   BEGIN
  537.     INC(DispZeile); SetPos(18,17); WriteInt(DispZeile);
  538.     GetC(c); Leerzeichen:=0; oldattr:=attr;
  539.     WHILE c>17C DO
  540.       CASE c OF
  541.         30C: IF print THEN 
  542.                SetPrintPos;
  543.                NextC(c); GetInt(d); NextC(c); GetInt(d); c:=1C;
  544.                d:=d+FNOffset; IntToString(h,d);
  545.                PrintString(h); (* c ist jetzt $18 *) END;
  546.       | 31C: c:='-';
  547.       | 33C: NextC(attr); IF ZeileistLeer THEN oldattr:=attr END;
  548.              IF print THEN SetPrintPos; SetAttribut(attr);
  549.                       ELSE ZeileistLeer:=FALSE  END;
  550.       | 34C: IF SkipEinsC>0 THEN DEC(SkipEinsC) 
  551.              ELSE INC(Leerzeichen);
  552.                   IF SkipEinsC<0 THEN INC(Leerzeichen); INC(SkipEinsC) END;
  553.              END;
  554.       | 35C,36C: INC(Leerzeichen);
  555.       | 37C: RETURN;
  556.       | 40C: INC(Leerzeichen);
  557.       ELSE
  558.       END;
  559.       IF c>40C THEN
  560.         ueberspringen:=FALSE;
  561.         IF print THEN SetPrintPos; SendChar(c);
  562.                  ELSE ZeileistLeer:=FALSE; END;
  563.       END;
  564.       NextC(c);
  565.     END;
  566.     IF print THEN SteuerCode(23H,-1) END;
  567.   END ScanLine;
  568.   
  569. PROCEDURE DruckeFussnote;
  570.   VAR HPuffer : LONGINT; hl,i : CARDINAL; newline : BOOLEAN; c : CHAR;
  571.       h : ARRAY[0..3] OF CHAR; z : INTEGER;
  572.   BEGIN
  573.     TextP:=Puffer;
  574.     Puffer:=FNP;
  575.     IF print THEN
  576.       SetPitch(FNPitch);
  577.       z:=PageLength-FNcp;
  578.       IF z<=Zeile THEN Zeile:=Zeile+LineHight[FNPitch.p]
  579.                   ELSE Zeile:=z END;
  580.       IF FNRandOben>0 THEN
  581.         Zeile:=Zeile+(FNRandOben-1)*LineHight[FNPitch.p];
  582.         ZeilenAnfang(FNPitch,10C);
  583.         FOR i:=1 TO VAL(CARDINAL,FNStrich) DO SendChar(' ')  END;
  584.         SetAttribut(0C); SteuerCode(23H,-1);
  585.         Zeile:=Zeile+LineHight[FNPitch.p];
  586.       END;
  587.       Zeile:=Zeile+FNRandUnten*LineHight[FNPitch.p];
  588.     END;
  589.   
  590.     WHILE FNist<FN2 DO                          (* Zeiger steht auf 'N' *)  
  591.  
  592.       WHILE FNist<FN1 DO
  593.         SucheEinsF('N'); (* Zeiger steht auf 'N' *)
  594.         NextC(c); GetInt(FNist); GetC(c); IF c=0C THEN FNist:=9999 END;
  595.       END (* WHILE FNist<FN1 DO *);
  596.  
  597.       SkipLine;
  598.       IF print THEN
  599.         IntToString(h,FNist+FNOffset);
  600.         ZeilenAnfang(FNPitch,20C);
  601.         GetC(c); i:=0;
  602.         WHILE (c<40C)&(i<3) DO
  603.           IF c=33C THEN NextC(FNattribut); NextC(c) END;
  604.           NextC(c); INC(i);
  605.         END;
  606.         hl:=3-Length(h); FOR i:=1 TO hl DO SendChar(' ') END;
  607.         PrintString(h);
  608.         ZeileistLeer:=FALSE;
  609.  
  610.         GetC(c);
  611.         WHILE (c#0C) & (c#37C) DO
  612.           IF c=13C THEN NextC(c); NextC(c) END; (* darf nicht vorkommen! *)
  613.           IF c>17C THEN
  614.             IF ~ZeileistLeer THEN SetAttribut(FNattribut) END;
  615.             ScanLine(0,FNattribut,FNPitch); ZeileistLeer:=TRUE;
  616.           END;
  617.           SkipLine; GetC(c);
  618.           Zeile:=Zeile+LineHight[FNPitch.p];
  619.         END (* WHILE c#0 & c#37C *);
  620.       END (* IF print *);
  621.       INC(FN1);
  622.     END (* WHILE FNist<=FN2 *);
  623.     FNP:=Puffer;
  624.     Puffer:=TextP;
  625.   END DruckeFussnote;
  626.  
  627. PROCEDURE SeitenAnfang;
  628.   VAR i :INTEGER;
  629.   BEGIN
  630.     PageNum:=ABS(PageNum);
  631.     print:= (PageNum>=ErsteSeite) & (PageNum<=LetzteSeite) & ~ende;
  632.     LineNum:=0; DispZeile:=0;
  633.     SetPos(18,0); WriteString('Seite:'); WriteInt(PageNum); 
  634.     WriteString(', Zeile:  0');
  635.     Zeile:=RandOben*LineHight[MainPitch.p];
  636.     IF print THEN
  637.       Message('Drucken ...');
  638.       IF undefiniert THEN 
  639.         SteuerCode(1FH,-1);           (* Init Horizontal  *)
  640.         SteuerCode(20H,-1);           (* Init Vertikal    *)
  641.         SteuerCode(24H,-1);           (* Zeilen/Seite     *)
  642.         SendChar(CHR(WpPageLength));
  643.         SteuerCode(36H,-1);           (* Proportional aus *)
  644.         SetPitch(MainPitch);
  645.         SetAttribut(0C);
  646.         undefiniert:=FALSE;
  647.       END;
  648.       IF KopfZeile.exists THEN
  649.         IF KopfZeile.underlined THEN ZeilenAnfang(MainPitch,10C)
  650.                                 ELSE ZeilenAnfang(MainPitch,0C) END; 
  651.         PrintKopfZeile(KopfZeile);
  652.         PrintedPages:=PageNum;
  653.       END;
  654.     ELSE Message('Suchen ...')
  655.     END;
  656.     Zeile:=Zeile+RandText*LineHight[MainPitch.p];
  657.     FNcp:=0; FN1:=0; FN2:=0; ueberspringen:=TRUE; ZeileistLeer:=TRUE;
  658.   END SeitenAnfang;
  659.  
  660. PROCEDURE SeitenEnde;
  661.   VAR i:INTEGER;
  662.   BEGIN
  663.     IF print THEN
  664.       IF (FN1>0) THEN DruckeFussnote END;
  665.       IF FussZeile.exists THEN
  666.         Zeile:=PageLength+(RandFuss-2)*LineHight[MainPitch.p];
  667.         IF FussZeile.underlined THEN
  668.           ZeilenAnfang(MainPitch,10C);
  669.           FOR i:=1 TO LinkerRand-1 DO SendChar(' ') END;
  670.           FOR i:=LinkerRand TO RechterRand DO SendChar(' ') END;
  671.           SteuerCode(23H,-1);
  672.         END;
  673.         Zeile:=Zeile+LineHight[MainPitch.p]-1;
  674.         ZeilenAnfang(MainPitch,0C); 
  675.         PrintKopfZeile(FussZeile);
  676.       END;
  677.       IF S.c[1EH]>0 THEN 
  678.         PrintFormFeed
  679.       ELSE 
  680.         IF Zeile<WpPageLength*LineHight[MainPitch.p] THEN
  681.           Zeile:=WpPageLength*LineHight[MainPitch.p];
  682.           GotoLineNum(Zeile);
  683.         END;
  684.       END;
  685.     END (* IF print THEN *);
  686.     LineNum:=0;
  687.     IF PageNum<0 THEN PageNum:=-PageNum END;
  688.     PageNum:=PageNum+1;
  689.     IF LetzteSeite<PageNum THEN fertig:=TRUE; print:=FALSE; 
  690.                                 Puffer:=PufferTop+1D END;
  691.     PageNum:=-PageNum;
  692.   END SeitenEnde;
  693.   
  694. PROCEDURE IntLength( i : INTEGER ) : INTEGER;
  695.   VAR l : INTEGER;
  696.   BEGIN
  697.     IF i<=0 THEN l:=1; i:=-i ELSE l:=0 END;
  698.     WHILE i>0 DO i:=i DIV 10; INC(l) END;
  699.     RETURN l;
  700.   END IntLength;
  701.  
  702. PROCEDURE Block(VAR p : Schriftart; VAR c : CHAR);
  703.   VAR i,fnZeilen,fcp, cp, fNum, EinsC : INTEGER; 
  704.       HP : LONGINT;
  705.       Nichtueberspringen : BOOLEAN;
  706.       x : CHAR; h : ARRAY[0..5] OF CHAR;
  707.   BEGIN
  708.     GetC(c); Nichtueberspringen:=FALSE;
  709.     WHILE (c#0C) & (c#37C) DO (* Zeilenschleife *)
  710.       IF (c=14C) THEN SeitenEnde; NextC(c);
  711.       ELSE
  712.         fNum:=0; EinsC:=0; fcp:=0;
  713.         IF c=13C THEN 
  714.           NextC(x); NextC(c);
  715.           cp:=ORD(x); IF cp>80H THEN cp:=110H-cp END;
  716.           cp:=cp-10H; Nichtueberspringen:=(cp>1);
  717.           cp:=cp*LineHight[p.p];
  718.         ELSE
  719.           cp:=LineHight[p.p];
  720.         END;
  721.         HP:=Puffer;
  722.         WHILE (c>17C) & (c#37C) DO (* nach Fussnote suchen und cp berechnen *)
  723.           WHILE (c>17C)&(c#30C) DO NextC(c) END;
  724.           IF c=30C THEN
  725.             NextC(c); GetInt(fnZeilen); NextC(c); GetInt(fNum);
  726.             IF ~print THEN FNP:=Puffer END;
  727.             IF fnZeilen>0 THEN
  728.               EinsC:=EinsC+IntLength(fNum+FNOffset)-IntLength(fNum+oldFNOffset);
  729.               IF (FNcp=0)&(fcp=0) THEN
  730.                 fcp:=fcp+(FNRandOben+FNRandUnten)*LineHight[FNPitch.p] END;
  731.               fcp:=fcp+LineHight[FNPitch.p]*fnZeilen;
  732.             END;
  733.             NextC(c);
  734.           END; (* IF c=30C *)
  735.         END (* WHILE c>17C *);
  736.         Puffer:=HP; GetC(c);
  737.         
  738.         IF ((Zeile+cp+FNcp+fcp)>PageLength) & (PageNum>0) THEN 
  739.           SeitenEnde;
  740.  
  741.         END;
  742.         IF (c#37C) & ~fertig THEN
  743.           IF PageNum<0 THEN 
  744.             SeitenAnfang;
  745.             IF fNum>0 THEN
  746.               FNcp:=(FNRandOben+FNRandUnten)*LineHight[FNPitch.p];
  747.             END;
  748.             IF Nichtueberspringen THEN ueberspringen:=FALSE END;
  749.           END;
  750.           IF fNum>0 THEN 
  751.             IF FN1=0 THEN FN1:=fNum END;
  752.             FN2:=fNum; FNcp:=FNcp+fcp;
  753.           END;
  754.           (* Zeile bearbeiten *)
  755.           IF (c>0C)&(c#37C) THEN
  756.             IF c>17C THEN 
  757.               ScanLine(EinsC,TextAttribut,TextPitch) END (* IF c>17C *);
  758.             IF ~(ueberspringen & ZeileistLeer) THEN Zeile:=Zeile+LineHight[p.p] END;
  759.             SkipLine; ZeileistLeer:=TRUE;
  760.           END;
  761.         END (* IF ~fertig *);
  762.         GetC(c);
  763.       END (* IF c=14C .. ELSE *);
  764.     END (* WHILE *);
  765.   END Block;
  766.  
  767. PROCEDURE Drucken;
  768.   VAR ok : BOOLEAN;
  769.       c : CHAR; h : ARRAY[0..1] OF CHAR;
  770.   BEGIN
  771.     IF ausgabe=datei THEN
  772.       ok:=GEMDOS.Delete(OutDatei);
  773.       GEMDOS.Create(OutDatei,0,PrnHandle);
  774.       IF PrnHandle<0 THEN
  775.         Message('Konnte Ausgabedatei nicht öffnen!');
  776.         ausgabe:=parallel;
  777.         RETURN
  778.       ELSE 
  779.         Message('Ausgabedatei geöffnet'); PrintHandle(PrnHandle);
  780.       END;
  781.     END;
  782.     IF ausgabe=datei THEN 
  783.       PrintHandle(PrnHandle); Ready:=DateiReady;
  784.     ELSIF ausgabe=parallel THEN
  785.       PrintHandle(3); Ready:=GEMDOS.PrnOS;
  786.     ELSE PrintHandle(2); Ready:=GEMDOS.AuxOS END;
  787.     PufferT:=PufferTop;
  788.     TextP:=PStart; FNP:=PStart; Puffer:=PStart;
  789.     FNist:=0; FNcp:=0; FN1:=0; FN2:=0;
  790.     PrinterTimeout:=500D;
  791.     PageLength:=(LHTeiler DIV 6)*WpPageLength-(RandFuss-RandUnten)*LineHight[MainPitch.p];
  792.     PageNum:=-1; TextAttribut:=0C; FNattribut:=0C;
  793.     PrintedPages:=0;
  794.     ende:=FALSE; fertig:=FALSE;
  795.     SetLQ(LQ);
  796.     Zeile:=0; LineNum:=0;
  797.     undefiniert:=TRUE;
  798.     REPEAT UNTIL ~KeyPressed();
  799.     REPEAT
  800.       Block(TextPitch,c);
  801.       IF c#0C THEN
  802.         NextC(c);
  803.         CASE c OF
  804.           '1': KopfZeileLesen(KopfZeile); SkipLine; GetC(c);
  805.         | '2': KopfZeileLesen(FussZeile); SkipLine; GetC(c);
  806.         | '9': LinealLesen(FALSE,TextPitch); SetPitch(TextPitch); SkipLine; GetC(c);
  807.         | 'N': SucheEinsF('E'); SkipLine; GetC(c);
  808.         ELSE
  809.           msg:='Unvorhergesehener Fall in >Drucken<.'; h:=' '; h[0]:=c;
  810.           Concat(msg,h,msg); Message(msg);
  811.         END;
  812.       END;
  813.     UNTIL (c=0C) OR ende OR fertig;
  814.     SeitenEnde;
  815.     IF ~undefiniert THEN SteuerCode(21H,-1) END;
  816.     IF ausgabe=datei THEN ok:=GEMDOS.Close(PrnHandle) END;
  817.     IF ende THEN Message('Druck abgebrochen bei'); 
  818.             ELSE Message('Druck beendet:') END;
  819.     WriteInt(PrintedPages); Write('/'); 
  820.     WriteInt(PrintedPages+PageNumOffset); WriteString(' Seiten.');
  821.   END Drucken;
  822.   
  823. PROCEDURE DateiWaehlen(VAR exit : BOOLEAN);
  824.   VAR dta : POINTER TO DTAType;
  825.       handle:INTEGER;
  826.       ok : BOOLEAN;
  827.   BEGIN
  828.     GrafMouse(257,NIL);
  829.     msg:='Bitte Textdatei auswählen...';
  830.     ExSelectFilename(TxtMaske,TxtDateiName,exit,msg);
  831.     IF ~exit THEN
  832.       IF PufferBottom#0D THEN
  833.         P:=VAL(ADDRESS,PufferBottom); Deallocate(P); PufferBottom:=0D END;
  834.       compose(TxtDateiName, TxtMaske, TxtDatei);
  835.       GEMDOS.SFirst(TxtDatei,0,handle);
  836.       GEMDOS.GetDTA(dta);
  837.       IF (handle=0) & Available(dta^.Laenge) THEN 
  838.         GEMDOS.Open(TxtDatei,0,handle);
  839.         PufferLaenge:=dta^.Laenge;
  840.         Allocate(P,PufferLaenge); 
  841.         PufferBottom:=VAL(LONGINT,P);
  842.         PufferTop:=PufferBottom+PufferLaenge-1D;
  843.         GEMDOS.Read(handle,PufferLaenge,P);
  844.         ok:=GEMDOS.Close(handle);
  845.         Message('Datei geladen');
  846.         GetParameter(ok);
  847.         Assign(TxtHeadName,TxtDateiName.name); Concat(TxtHeadName,'.',TxtHeadName);
  848.         Concat(TxtHeadName,TxtDateiName.ext,TxtHeadName);
  849.         TxtHeadPath:=' :'; TxtHeadPath[0]:=TxtDateiName.drv;
  850.         Concat(TxtHeadPath,TxtDateiName.path,TxtHeadPath);
  851.       ELSE exit:=TRUE;
  852.       END (* IF Available *);
  853.     END (* IF ~exit *);
  854.     IF exit THEN Assign(Title,'Keine Datei ausgewählt');
  855.                  TxtDatei:='';
  856.                  Message(Title);
  857.             ELSE Assign(Title,TxtDatei) END;
  858.     NewTitle(Title);
  859.     GrafMouse(256,NIL);
  860.   END DateiWaehlen;
  861.  
  862. PROCEDURE TreiberLaden( select : BOOLEAN; VAR exit : BOOLEAN);
  863.   BEGIN
  864.     GrafMouse(257,NIL);
  865.     IF select THEN
  866.       msg:='Druckertreiber auswählen ...';
  867.       ExSelectFilename(CfgMaske,CfgDateiName,exit,msg);
  868.     ELSE exit:=FALSE END;
  869.     IF ~exit THEN
  870.       compose(CfgDateiName,CfgMaske,CfgDatei);
  871.       ConfigPrinter(3,CfgDatei,' ');
  872.       IF CfgError=GEMDOS.EFilNF THEN exit:=TRUE
  873.         ELSE Message('Druckertreiber geladen'); ParameterBerechnen END;
  874.     END;
  875.     GrafMouse(256,NIL);
  876.   END TreiberLaden;
  877.   
  878. PROCEDURE SelectOutfile;
  879.   VAR exit : BOOLEAN;
  880.   BEGIN
  881.     GrafMouse(257,NIL);
  882.     msg:='Ausgabedatei auswählen...';
  883.     ExSelectFilename(OutMaske,OutName,exit,msg);
  884.     IF ~exit THEN compose(OutName,OutMaske,OutDatei) END;
  885.     GrafMouse(256,NIL);
  886.   END SelectOutfile;
  887.   
  888.  
  889. PROCEDURE Menue(VAR c : CHAR);
  890.   VAR ok : BOOLEAN; h : ARRAY[0..13] OF CHAR;
  891.   PROCEDURE ChValue(lin,col,max:INTEGER; VAR n : INTEGER );
  892.     VAR h : ARRAY[0..3] OF CHAR; x : CARDINAL; ok : BOOLEAN; y : INTEGER;
  893.     BEGIN
  894.       h:=''; SetPos(lin,col); WriteString('   ');
  895.       ReadString(lin,col,h); ok:=TRUE;
  896.       FOR x:=0 TO Length(h)-1 DO 
  897.         ok:=ok AND (((h[x]<='9') AND (h[x]>='0')) OR 
  898.                      (h[x]='-') OR (h[x]='+')) END;
  899.       IF ok THEN StringToInt(h,y); ok:=y<=max END;
  900.       IF ok THEN Message('ok.'); n:=y; 
  901.             ELSE Message('Eingabefehler, Wert muß ≤'); 
  902.                  WriteInt(max); WriteString(' sein.'); END;
  903.     END ChValue;
  904.   PROCEDURE ZeigeZeilenHoehe( p:Schriftarten);
  905.     BEGIN
  906.       WriteInt(LineHight[p]); Write('/'); 
  907.       WriteInt(LHTeiler); Write('"');
  908.       IF MainPitch.p=p THEN Write('H')
  909.                      ELSE Write(' ') END;
  910.       IF FNPitch.p=p   THEN Write('F')
  911.                      ELSE Write(' ') END;
  912.     END ZeigeZeilenHoehe;
  913.   PROCEDURE Value(x : CHAR);
  914.     BEGIN
  915.       h:='';
  916.       CASE x OF
  917.         'A': Fill(LeerString,70,' ');
  918.              SetPos(6,2); WriteString(LeerString); SetPos(5,21);
  919.              IF ausgabe=parallel THEN WriteString('Drucker')
  920.              ELSIF ausgabe=datei THEN WriteString('Datei  ');
  921.                WriteLn; WriteString('   N Name der Datei:');
  922.                Tab(21); WriteString(OutDatei);
  923.              ELSE WriteString('seriell');
  924.              END;
  925.       | 'S': SetPos( 9,21); WriteInt(PageNumOffset);
  926.       | 'F': SetPos(10,21); WriteInt(FNOffset);
  927.       | '1': SetPos(11,21); WriteInt(ErsteSeite);
  928.       | '9': SetPos(12,21); WriteInt(LetzteSeite);
  929.       | 'R': SetPos(13,21); WriteInt(LineOffset);
  930.       | 'W': SetPos(14,21); WriteInt(WpPageLength);
  931.              IF Length(TxtHeadName)>0 THEN
  932.                SetPos(3,55); 
  933.                WriteInt(WpPageLength); 
  934.                WriteString(' Zeilen/Seite');
  935.              END;
  936.       | 'K': SetPos(15,37);
  937.              IF KopfAlternierend THEN WriteString('Ja  ')
  938.                                  ELSE WriteString('Nein') END;
  939.       | 'P': SetPos( 9,60); ZeigeZeilenHoehe(Pica);
  940.       | 'E': SetPos(10,60); ZeigeZeilenHoehe(Elite);
  941.       | 'C': SetPos(11,60); ZeigeZeilenHoehe(Schmal);
  942.       | 'B': SetPos(12,60); ZeigeZeilenHoehe(Breit);
  943.       | 'Y': SetPos(13,56); WriteString(DateString);
  944.       | 'Z': SetPos(14,56); WriteString(TimeString);
  945.       | 'L': SetPos(15,56); IF LQ THEN WriteString('Ja  ')
  946.                                   ELSE WriteString('Nein') END;
  947.       | 'Q': Message('Programmende.');
  948.       | 'T': SetPos(3,21); WriteString(LeerString); Tab(21); 
  949.              IF Length(TxtHeadName)>0 THEN 
  950.                WriteString(TxtHeadName);
  951.                WriteString(', '); LongIntToString(h,PufferLaenge);
  952.                WriteString(h); WriteString(' Bytes,'); Tab(48);
  953.                CASE MainPitch.p OF
  954.                  Pica:   h:='Pica,';
  955.                | Elite:  h:='Elite,';
  956.                | Schmal: h:='Schmal,'; 
  957.                | Breit:  h:='Breit,';
  958.                ELSE
  959.                END;
  960.                WriteString(h);
  961.              END;
  962.       ELSE
  963.       END;
  964.     END Value;
  965.   BEGIN
  966.     REPEAT
  967.       Fill(LeerString,55,' ');
  968.       SetPos(0,0); WriteString(LeerString); SetPos(0,8);
  969.       WriteString('Druckprogramm für 1stWordPlus mit variablem Zeilenabstand V1.3');
  970.       SetPos(1,25); WriteString('©3/90 by Uwe Ischebeck'); WriteLn;
  971.       WriteLn;
  972.       WriteString(' T TextDatei:'); Value('T'); WriteLn;
  973.       WriteString(' D Druckertreiber:'); Tab(21); WriteString(LeerString);
  974.         Tab(21); WriteString(S.n^); WriteLn;
  975.       WriteString(' A Ausgabe auf:'); WriteLn;
  976.       WriteLn;
  977.       WriteLn;
  978.       WriteString(' Offset:'); Tab(45); WriteString('Zeichenhöhe:'); WriteLn;
  979.       WriteString('   S Seitennummer:'); Tab(47); WriteString('P Pica:'); WriteLn;
  980.       WriteString('   F Fussnoten:'); Tab(47); WriteString('E Elite:'); WriteLn;
  981.       WriteString(' 1 Erste Seite:'); Tab(47); WriteString('C Compressed:'); WriteLn;
  982.       WriteString(' 9 Letzte Seite:'); Tab(47); WriteString('B Breit:'); WriteLn;
  983.       WriteString(' R Rand links:'); Tab(45); WriteString('Y Datum:'); WriteLn;
  984.       WriteString(' W WP Seitenlänge:'); Tab(45); WriteString('Z Uhrzeit:'); WriteLn;
  985.       WriteString(' K Kopf- und Fußzeilen auf geraden'); Tab(45); WriteString('L LQ:'); WriteLn;
  986.       WriteString('   und ungeraden Seiten vertauschen'); WriteLn;
  987.       Tab(37); WriteString('G (Go) Druck starten,    Q Quit (Ende)');
  988.       Value('A'); 
  989.       Value('S'); Value('F'); Value('1'); Value('9'); Value('R'); Value('W');
  990.       Value('P'); Value('E'); Value('C'); Value('B'); 
  991.       Value('K'); Value('Y'); Value('Z'); Value('L'); 
  992.       REPEAT
  993.         SetPos(18,0); WriteString(' Make your choice >         '); Tab(19);
  994.         Read(c); c:=CAP(c); 
  995.         IF c>37C THEN Write(c); WriteString('   ');
  996.                  ELSE WriteInt(ORD(c)) END;
  997.         WriteLn;
  998.         Message('  ');
  999.         CASE c OF
  1000.           'S': ChValue( 9,21,999,PageNumOffset);
  1001.         | 'F': ChValue(10,21,999,FNOffset);
  1002.         | '1': ChValue(11,21,999,ErsteSeite);
  1003.         | '9': ChValue(12,21,999,LetzteSeite);
  1004.         | 'R': ChValue(13,21,70,LineOffset);
  1005.         | 'W': ChValue(14,21,255,WpPageLength);
  1006.         | 'P': ChValue( 9,60,255,LineHight[Pica]);
  1007.         | 'E': ChValue(10,60,255,LineHight[Elite]);
  1008.         | 'C': ChValue(11,60,255,LineHight[Schmal]);
  1009.         | 'B': ChValue(12,60,255,LineHight[Breit]);
  1010.         | 'K': KopfAlternierend:=~KopfAlternierend;
  1011.         | 'L': LQ:=~LQ;
  1012.         | 'Y': ReadString(13,56,DateString);
  1013.         | 'Z': ReadString(14,56,TimeString);
  1014.         | 'A': IF    ausgabe=parallel THEN ausgabe:=seriell;
  1015.                ELSIF ausgabe=datei THEN ausgabe:=parallel;
  1016.                ELSE
  1017.                  ausgabe:=datei;
  1018.                  IF Length(OutDatei)=0 THEN SelectOutfile; c:='N'; END
  1019.                END;
  1020.         | 'N': IF ausgabe=datei THEN SelectOutfile END;
  1021.         | 'D': TreiberLaden(TRUE,ok);
  1022.         | 'G': IF noFile THEN Message('Keine Textdatei ausgewählt!');
  1023.                ELSE Message('Starte Druck...'); Drucken;
  1024.                END;
  1025.         | 'Q': SetPos(18,0);
  1026.                WriteString('Programmende (J/N)? '); Tab(19);
  1027.                Read(c); c:=CAP(c);
  1028.                IF c='J' THEN c:='Q'
  1029.                         ELSE c:=' '
  1030.                         END;
  1031.         ELSE
  1032.         END;
  1033.         Value(c);
  1034.       UNTIL (c='Q') OR (c='N') OR (c='T') OR (c='D');
  1035.     UNTIL (c='Q') OR (c='T');
  1036.   END Menue;
  1037.  
  1038. BEGIN
  1039.   Init;
  1040.   InitTerminal(TRUE);
  1041.   WindowGet(0,WorkXYWH,xmin, ymin, breite, hoehe);
  1042.   IF breite>500 THEN 
  1043.     GrafMouse(256,NIL);
  1044.     xmin:=xmin+8; breite:=breite-8; ymin:=ymin+10; hoehe:=hoehe-10;
  1045.     Title:='Druckprogramm für 1stWord Plus'; NewTitle(Title);
  1046.     OpenTerminal(xmin,ymin,breite,hoehe);
  1047.     Fill(LeerString,70,' ');
  1048.     PufferBottom:=0D;
  1049.     ausgabe:=parallel;
  1050.     TxtHeadName:='';
  1051.     GetDriveAndPath(TxtMaske); TxtMaske.name:='*'; TxtMaske.ext:='*';
  1052.     CfgMaske:=TxtMaske; CfgMaske.ext:='CFG';
  1053.     OutMaske:=TxtMaske; OutMaske.ext:='PRN';
  1054.     ClearFilename(TxtDateiName);
  1055.     CfgDateiName:=TxtDateiName;
  1056.     OutDatei:='';
  1057.     OutName:=TxtDateiName; OutName.name:='DEFAULT'; OutName.ext:='PRN';
  1058.     compose(OutName,OutMaske,OutDatei);
  1059.     PrnHandle:=3;
  1060.     WITH CfgDateiName DO name:='WPRINT'; ext:='CFG' END;
  1061.     TreiberLaden(FALSE,ende);
  1062.     IF ende THEN TreiberLaden(TRUE,ende) END;
  1063.     IF ~ende THEN (* ohne Treiber geht nichts *)
  1064.       REPEAT
  1065.         ende:=FALSE;
  1066.         Initialisieren;
  1067.         DateiWaehlen(noFile);
  1068.         Menue(c);
  1069.       UNTIL (c='Q') OR ende;
  1070.     END;
  1071.     CloseTerminal;
  1072.     DeleteTerminal;
  1073.     IF PufferBottom#0D THEN P:=VAL(ADDRESS,PufferBottom); Deallocate(P) END;
  1074.     GrafMouse(257,NIL);
  1075.   ELSE
  1076.     BoxText:='[1][ Läuft nur in hoher | und mittlerer Auflösung! ][ schade ]';
  1077.     xmin:=FormAlert(1,BoxText);
  1078.   END;
  1079.   Terminate;
  1080. END WPrint.
  1081.